home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / manchester / 4.1 / go-to-project.st < prev    next >
Text File  |  1993-07-24  |  3KB  |  94 lines
  1. "    NAME        go-to-project
  2.     AUTHOR        miw@cs.man.ac.uk (Mario Wolczko)
  3.     FUNCTION    Uses a menu to navigate the project hierarchy
  4.     ST-VERSION    4.1
  5.     PREREQUISITES    collections-misc
  6.     CONFLICTS    
  7.     DISTRIBUTION    world
  8.     VERSION        1
  9.     DATE         9 Nov 1992
  10. SUMMARY
  11. If you have lots of projects it's a little clumsy getting from one to
  12. the other.  This goodies provides a method, Project>selectAndEnter,
  13. that builds a hierarchical menu of projects so that you can jump
  14. around directly.  You might want to put this on a launcher menu.
  15.  
  16. For the labels to be sensible, you must enter and accept some text
  17. into each project.
  18.  
  19. Mario Wolczko
  20.  
  21. Dept. of Computer Science   Internet:      mario@cs.man.ac.uk
  22. The University              uucp:      mcsun!!ukc!!man.cs!!mario
  23. Manchester M13 9PL          JANET:         mario@uk.ac.man.cs
  24. U.K.                        Tel: +44-61-275 6146  (FAX: 6236)
  25. ______the mushroom project___________________________________
  26.  
  27. "
  28. 'From Objectworks\Smalltalk(R), Release 4.1 of 15 April 1992 on 9 November 1992 at 9:37:32 pm'!
  29.  
  30.  
  31.  
  32. !Project methodsFor: 'accessing'!
  33.  
  34. subProjects
  35.     "Answer a collection of projects that are directly contained by self."
  36.     "Project root subProjects"
  37.     ^OrderedCollection accumulate: [ :add |
  38.         self windows scheduledControllers do:
  39.             [:sc || proj |
  40.                 ((proj := sc model) isKindOf: Project)
  41.                     ifTrue: [add value: proj]]]! !
  42.  
  43. !Project methodsFor: 'testing'!
  44.  
  45. hasSubProjects
  46.     "Do I have sub-projects?"
  47.     ^self windows scheduledControllers anySatisfy: [ :sc | sc model isKindOf: Project]! !
  48.  
  49.  
  50. !Project class methodsFor: 'viewing'!
  51.  
  52. labelFor: project
  53.     ^project value isEmpty
  54.         ifTrue: [project holder == project
  55.                     ifTrue: ['root']
  56.                     ifFalse: ['unnamed']]
  57.         ifFalse: [(project value copyUpTo: Character cr) contractTo: 25]!
  58.  
  59. popUpMenuFor: project
  60.     "Create a menu for project and its subprojects."
  61.     | label subProjects labels list |
  62.     label := self labelFor: project.
  63.     subProjects := project subProjects.
  64.     labels := IdentityDictionaryWithDefault newWithDefaultValueBlock: [ :p | self labelFor: p].
  65.     list := subProjects asSortedCollection: [ :p1 :p2 | (labels at: p1) <= (labels at: p2)].
  66.     ^PopUpMenu
  67.         labelList:
  68.             (Array with: (Array with: label) with: (list collect: [ :p | labels at: p]))
  69.         values:
  70.             ((Array with: project), 
  71.             (list collect: [ :p |
  72.                 p hasSubProjects
  73.                     ifTrue: [self popUpMenuFor: p]
  74.                     ifFalse: [p]]))!
  75.  
  76. selectAndEnter
  77.     "Project selectAndEnter"
  78.     | root proj |
  79.     root := self root.
  80.     root hasSubProjects
  81.         ifFalse: [DialogView warn: 'Only one project!!'.  ^self].
  82.     proj := (self popUpMenuFor: root) startUp.
  83.     proj ~~ 0 ifTrue: [proj enter]! !
  84.  
  85. !Project class methodsFor: 'constants'!
  86.  
  87. root
  88.     "Return the root project."
  89.     | project |
  90.     project := Project current.
  91.     [project holder == project] whileFalse: [project := project holder].
  92.     ^project! !
  93.  
  94.